home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Sample Code / Snippets / Devices / CD Tracker / CDTracker.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-14  |  11.1 KB  |  389 lines  |  [TEXT/TPAS]
  1. PROGRAM    CDTracker;
  2. {$R CDTracker.Rsrc}
  3. {$U-}
  4.  
  5. USES
  6.     Memtypes,QuickDraw,OSIntf,ToolIntf,PackIntf;
  7.  
  8.  
  9. CONST
  10.     TextStatItem = 2;   {Item number of static text}
  11.     textItem = 3;        {item number for editable text item}
  12. TYPE
  13.     ReadTOCBlk = record
  14.     theBytes : packed array [0..3] of byte;
  15.     end;
  16.     twoBytes = ARRAY [0..1] of signedbyte;
  17.  
  18. VAR
  19.     err : integer;
  20.              DoErrDialPtr,DialPtr,oldPort : DialogPtr;
  21.              DialTitle,GuessStr,RealStr : str255;
  22.              isVis, DialGoAway : boolean;
  23.              DialRefCon : longint;
  24.              DialItemHit, DITLID : integer;
  25.              DITLHndl : handle;
  26.     CloseWind,PassWrdOK :boolean;
  27.     x,y,z : integer;        {scratch ints}
  28.     theType : integer;   {gives the type of the item requested}
  29.     theTextHdl : handle;    {gives a handle to the item}
  30.     txtBox : Rect;    {gives the display rectangle of the item}
  31.     PBlkPtr     : ParmBlkPtr;
  32.     Pblk        : ParamBlockRec;
  33.     theStr : str255;
  34.     VolRefN, FilRefN,DrvrRefNum : integer;
  35.     MyBuffer : ptr;
  36.     BigBuf,HowMuch : longint;
  37.     MyFFSynthPtr : FFSynthPtr;
  38.     SoundAway, NoMore : boolean;
  39.     StartTrk,EndTrak,Minits,Secns,Framez,BCDTrackNo : signedbyte;
  40.     NumTracks, TrkIndex : integer;
  41.     EndOfDiskBlk : ReadTOCBlk;
  42.  
  43.  
  44.  
  45.         {------------------------------------------------------------------------------------}
  46.     
  47.   PROCEDURE debugger; INLINE $A9FF;
  48.  
  49.         {------------------------------------------------------------------------------------}
  50.  
  51.         PROCEDURE InitMac;
  52.  
  53.             BEGIN                       {InitMac}
  54.  
  55.    InitGraf (@thePort);          {the big five inits}
  56.    InitFonts;
  57.    InitWindows;
  58.    TEInit;
  59.    InitDialogs (nil);
  60.  
  61.             END;                       {InitMac}
  62.  
  63.         {------------------------------------------------------------------------------------}
  64.  
  65. FUNCTION BCDtoHex (SrcByte:signedbyte):integer;
  66.  
  67. VAR
  68.     x,y : integer;
  69.  
  70. begin
  71.     x := integer(SrcByte MOD 16);
  72.     y := integer(SrcByte DIV 16);
  73.     y := y*10;
  74.     BCDtoHex := x+y;
  75. end;
  76.  
  77.         {------------------------------------------------------------------------------------}
  78.  
  79. FUNCTION HextoBCD (SrcInt:integer):signedbyte;
  80.  
  81. VAR
  82.     x,y : integer;
  83.     z : signedbyte;
  84.  
  85. begin
  86.     z := $0;
  87.     x := SrcInt MOD 256;
  88.     y := x;
  89.     if y >= 10 then
  90.     begin
  91.         z := z + $10;
  92.         repeat
  93.             y := y-10;
  94.             if y > 10 then z := z + $10;
  95.         until (y < 10);
  96.     end;
  97.     HextoBCD := signedbyte(y)+z;
  98. end;
  99.  
  100.         {------------------------------------------------------------------------------------}
  101.  
  102. PROCEDURE DoError (ErStr : str255; err : longint);
  103.  
  104. VAR
  105.     NumStr : str255;
  106.  
  107.     Begin
  108.         GetPort (oldPort);
  109.         if err <> noerr then
  110.         begin
  111.         NumToString (err,NumStr);
  112.         ErStr := Concat (ErStr,NumStr);
  113.         end;
  114.         DITLID := 257;
  115.         DITLHndl := GetResource ('DITL', DITLID);
  116.         err := ResError;
  117.         if err = noerr then
  118.         begin
  119.         if DITLHndl <> nil then
  120.  
  121.         begin
  122.             Hlock (DITLHndl);
  123.             DoErrDialPtr := GetNewDialog (257,nil,WindowPtr(-1));
  124.             If DoErrDialPtr <> nil then
  125.             begin
  126.             GetDItem (DoErrDialPtr, TextStatItem, theType, theTextHdl, txtBox);
  127.             If theTextHdl <> nil then
  128.             begin
  129.      
  130.             SetPort (DoErrDialPtr);
  131.  
  132.             SetIText (theTextHdl, ErStr);
  133.             repeat
  134.             ModalDialog (nil, DialItemHit);
  135.             until DialItemHit <> 0;
  136.             Case DialItemHit of  {1 = OK btn, 2 = message}
  137.                 1,2 : CloseDialog (DoErrDialPtr);
  138.                                 
  139.                         end; {case}
  140.             end;
  141.             end;
  142.         end;
  143.         end;
  144.         setPort (oldPort);
  145.      end;
  146.  
  147.         {------------------------------------------------------------------------------------}
  148.  
  149. PROCEDURE GetTrackInfo (dRefNum,trackNo:integer);
  150.  
  151. TYPE
  152.     longintptr = ^ptr;
  153.     bytePtr = ^signedbyte;
  154. VAR
  155.     PB : ParamBlockRec;
  156.     theStr : str255;
  157.     aByte : signedbyte;
  158.     x,y,z : integer;
  159.     DataPtr : longintptr;
  160.     DataBlock : ReadTOCBlk;
  161.     BytePoint : bytePtr;
  162.     carry : boolean;
  163.  
  164. begin
  165. carry := false;
  166.     BCDTrackNo := HexToBCD (trackNo);
  167.     PB.ioCompletion := nil;
  168.     PB.ioRefNum := dRefNum;
  169.     PB.csCode := 100;
  170.     PB.csParam[0] := 3;
  171.     DataPtr := @PB.csParam[1];
  172.     DataPtr^ := @DataBlock;
  173.     PB.csParam[3] := 4;
  174.     bytePoint := @PB.csParam[4];
  175.     bytePoint^ := signedbyte(BCDTrackNo);
  176.     err := PBControl (@PB,false);
  177.     if err = noerr then
  178.     begin
  179.         if trackNo = NumTracks then
  180.         Begin
  181.             BytePoint := @PB.csParam[1];
  182.             BytePoint := bytePtr(longint(BytePoint)+1);
  183.             BytePoint^ := EndOfDiskBlk.theBytes[0];
  184.             BytePoint := bytePtr(longint(BytePoint)+1);
  185.             BytePoint^ := EndOfDiskBlk.theBytes[1];
  186.             BytePoint := bytePtr(longint(BytePoint)+1);
  187.             BytePoint^ := EndOfDiskBlk.theBytes[2];
  188.             BytePoint := bytePtr(longint(BytePoint)+1);
  189.         end
  190.         else
  191.         begin
  192.             PB.ioCompletion := nil;
  193.             PB.ioRefNum := dRefNum;
  194.             PB.csCode := 103;
  195.             PB.csParam[0] := 2;
  196.             PB.csParam[1] := 0;
  197.             z := BCDToHex (BCDTrackNo);
  198.             z := z+1;
  199.             aByte := HexToBCD (z);
  200.             PB.csParam[2] := aByte;
  201.             PB.csParam[3] := 0;
  202.             err := PBControl (@PB,false);
  203.             if err = noerr then
  204.                 begin
  205.                     PB.ioCompletion := nil;
  206.                     PB.ioRefNum := dRefNum;
  207.                     PB.csCode := 107;
  208.                     err := PBControl (@PB,false);
  209.                 end
  210.                 else doError ('PBControl (103) error = ',err);
  211.         end;
  212.         if err = noerr then
  213.         begin
  214.             NumToString(longint(trackNo),theStr);
  215.             GetDItem (DialPtr, 6, theType, theTextHdl, txtBox);
  216.             If theTextHdl <> nil then SetIText (theTextHdl,theStr);
  217.                 
  218.             aByte := DataBlock.theBytes[3];  {do frames first}
  219.             x := BCDtoHex (aByte);
  220.             aByte := signedbyte(twoBytes(PB.csParam[2])[1]);
  221.             y := BCDtoHex (aByte);
  222.             z := y-x;
  223.             if (z < 0) then
  224.             begin
  225.                 z := z + 74;   {74 frames/sec}
  226.                 carry := true;
  227.             end
  228.             else carry := false;
  229.             NumToString(z,theStr);
  230.             GetDItem (DialPtr, 9, theType, theTextHdl, txtBox);
  231.             If theTextHdl <> nil then SetIText (theTextHdl,theStr);
  232.                 
  233.             aByte := DataBlock.theBytes[2];  {do seconds second}
  234.             x := BCDtoHex (aByte);
  235.             aByte := signedbyte(twoBytes(PB.csParam[2])[0]);
  236.             y := BCDtoHex (aByte);
  237.             if carry then y := y-1;
  238.             z := y-x;
  239.             if (z < 0) then
  240.             begin
  241.                 z := z + 60;    {60 seconds/minute}
  242.                 carry := true;
  243.             end
  244.             else carry := false;
  245.             NumToString(z,theStr);
  246.             GetDItem (DialPtr, 8, theType, theTextHdl, txtBox);
  247.             If theTextHdl <> nil then SetIText (theTextHdl,theStr);
  248.                 
  249.             aByte := DataBlock.theBytes[1];
  250.             x := BCDtoHex (aByte);
  251.             aByte := signedbyte(twoBytes(PB.csParam[1])[1]);
  252.             y := BCDtoHex (aByte);
  253.             if carry then y := y-1;
  254.             z := y-x;
  255.             NumToString(z,theStr);
  256.             GetDItem (DialPtr, 7, theType, theTextHdl, txtBox);
  257.             If theTextHdl <> nil then SetIText (theTextHdl,theStr);
  258.         end
  259.         else doError ('PBControl (107) error = ',err);
  260.     end
  261.     else doError ('PBControl (100,3) error = ',err);
  262. end;
  263.                 
  264.         {------------------------------------------------------------------------------------}
  265.  
  266. PROCEDURE GetCDInfo(dRefNum:integer;VAR StrtTrk,EndTrk:signedbyte);
  267.     
  268. VAR
  269.     PB : ParamBlockRec;
  270.  
  271. begin
  272.     PB.ioCompletion := nil;
  273.     PB.ioRefNum := dRefNum;
  274.     PB.csCode := 100;
  275.     PB.csParam[0] := 1;
  276.     err := PBControl (@PB,false);
  277.     if err = noerr then
  278.     begin
  279.         StrtTrk := signedbyte(twoBytes(PB.csParam[0])[0]);
  280.         EndTrk := signedbyte(twoBytes(PB.csParam[0])[1]);
  281.     end
  282.     else doError ('PBControl (100,1) error = ',err);
  283. end;
  284.  
  285.         {------------------------------------------------------------------------------------}
  286.  
  287. PROCEDURE GetEndOfDisk (dRefNum:integer;VAR datablk:ReadTOCBlk);
  288.  
  289. VAR
  290.     PB : ParamBlockRec;
  291.  
  292. begin
  293.     PB.ioCompletion := nil;
  294.     PB.ioRefNum := dRefNum;
  295.     PB.csCode := 100;
  296.     PB.csParam[0] := 2;
  297.     err := PBControl (@PB,false);
  298.     if err = noerr then
  299.     begin
  300.         datablk.theBytes[0] := signedbyte(twoBytes(PB.csParam[0])[0]);
  301.         datablk.theBytes[1] := signedbyte(twoBytes(PB.csParam[0])[1]);
  302.         datablk.theBytes[2] := signedbyte(twoBytes(PB.csParam[1])[0]);
  303.         datablk.theBytes[3] := signedbyte(twoBytes(PB.csParam[1])[1]);
  304.     end
  305.     else doError ('PBControl (100,1) error = ',err);
  306. end;
  307.  
  308.     
  309.  
  310.         {------------------------------------------------------------------------------------}
  311.  
  312. FUNCTION GetDrvr:Integer;
  313.  
  314. VAR
  315.     MyReply : SFReply;
  316.     Place : point;
  317.     MyTypeList : SFTypeList;
  318.     PB : HParamBlockRec;
  319.     
  320. Begin
  321.     
  322.     Place.v := 50;
  323.     Place.h := 50;
  324.     SFGetFile (Place,'',nil,-1,MyTypeList,nil,MyReply);
  325.     if MyReply.good then
  326.     begin
  327.         PB.ioCompletion := nil;
  328.         PB.ioNamePtr := nil;
  329.         PB.ioVRefNum := MyReply.vRefNum;
  330.         PB.ioVolIndex := 0;
  331.         err := PBHGetVInfo (@PB,false);
  332.         if err = noerr then GetDrvr := PB.ioVDRefNum
  333.         else GetDrvr := 0;
  334.     end
  335.     else GetDrvr := 0;
  336. end;
  337.  
  338.         {------------------------------------------------------------------------------------}
  339.  
  340. begin
  341.     initmac;
  342.     DITLID := 256;
  343.     DITLHndl := GetResource ('DITL', DITLID);
  344.     err := ResError;
  345.     if err = noerr then
  346.     begin
  347.         if DITLHndl <> nil then
  348.                     begin
  349.             Hlock (DITLHndl);                    
  350.             DialPtr := GetNewDialog (256,nil,WindowPtr(-1));
  351.             SetPort (DialPtr);
  352.             If DialPtr <> nil then
  353.             begin
  354.                 DrvrRefNum := GetDrvr;
  355.                 GetCDInfo (DrvrRefNum,StartTrk,EndTrak);
  356.                 x := BCDtoHex (EndTrak);
  357.                 y := BCDtoHex (StartTrk);
  358.                 NumTracks := x-y+1;
  359.                 GetTrackInfo (DrvrRefNum,1);
  360.                 TrkIndex := 1;
  361.                 GetEndOfDisk (DrvrRefNum,EndOfDiskBlk);
  362.                 CloseWind := False;
  363.                 repeat
  364.                 begin
  365.                     repeat
  366.                     ModalDialog (nil, DialItemHit);
  367.                     until DialItemHit <> 0;
  368.                     Case DialItemHit of  {1 = OK btn, 10 = message, 3 = edittext}
  369.                     1 : begin
  370.                             CloseDialog (DialPtr);
  371.                             CloseWind := True;
  372.                         end;
  373.                     10 : begin
  374.                             TrkIndex := TrkIndex + 1;
  375.                             if TrkIndex > NumTracks then TrkIndex := 1;
  376.                             GetTrackInfo (DrvrRefNum,TrkIndex);
  377.                             If err <> noerr then trkIndex := trkIndex-1;
  378.                         end;
  379.                     end; {case}
  380.                 end;
  381.                 until closewind;
  382.             end 
  383.             else DoError ('DialPtr Nil',0);
  384.             HUnlock (DITLHndl);
  385.         end
  386.         else DoError ('DITL Handle Nil',0);
  387.     end
  388.     else DoError ('Resource Error = ',err);
  389. end.